(FILECREATED "15-APR-74 01:57:31" TOTAL)


  (LISPXPRINT (QUOTE TOTALVARS)
	      T)
  [RPAQQ TOTALVARS
	 ((FNS GSETQ GSET Y/N PUTPROP PRIN1L PRINT1 EDITM ?= DE FIRSTATOM 
	       COPYFILE PUTONFILE DOFILES RP LISTFILE1 IMIN IMAX DWIMUSERFN)
	  (USERMACROS ?= !← MAC EVAL - EF EP EV ;; LOCAL Q FV)
	  (ADVISE (CONCAT IN LISTFILES))
	  (P (SETQ ADVISEDFNS)
	     (SETQ LISPXMACROS (CONS (LIST (QUOTE ;)
					   (KWOTE (PACK)))
				     LISPXMACROS)))
	  (ADDVARS (PRETTYTYPELST (CHANGEDITMACROS USERMACROS "edit macros")
				  (NEWVARSLST VARS "variables")
				  (CHANGEDPROPLST PROP "properties")
				  (CHANGEDADVICELST ADVICE "advice"))
		   (HISTORYCOMS ;)
		   (LISPXCOMS ;))
	  (VARS (LPTSITE)
		(NEWVARSLST)
		(CHANGEDITMACROS)
		(CHANGEDPROPLST)
		(CHANGEDADVICELST)
		DWIMUSERFN)
	  (P (I.S.TYPE (QUOTE ANY)
		       (QUOTE (AND (SETQ $$VAL BODY)
				   (RETURN $$VAL)))
		       NIL
		       (QUOTE $$VAL))
	     (I.S.TYPE (QUOTE RCOLLECT)
		       (QUOTE (SETQ $$VAL (CONS BODY $$VAL)))
		       NIL
		       (QUOTE $$VAL))
	     (I.S.TYPE (QUOTE MAXIMUM)
		       (QUOTE (SETQ $$VAL (MAX $$VAL BODY)))
		       -27022703623
		       (QUOTE $$VAL))
	     (I.S.TYPE (QUOTE MINIMUM)
		       (QUOTE (SETQ $$VAL (MIN $$VAL BODY)))
		       27022703623
		       (QUOTE $$VAL]
(DEFINEQ

(GSETQ
(NLAMBDA (GSETVAR Y) (* Guaranteed to cause VARS to be marked as "CHANGED")
(GSET GSETVAR (EVAL Y))))

(GSET
(LAMBDA (X Y) (* Guaranteed to cause VARS to be marked as "CHANGED") (PROG1
(/SET X Y) (/RPLACA (QUOTE NEWVARSLST) (CONS X NEWVARSLST)))))

(Y/N
(NLAMBDA (DEFAULT MESS TYPEAHEADOKFLG) (* Prompts for one of DEFAULT, returning
the char typed, and completing the typein. DEFAULT is an alist of (firstchar
. restchars) - If MESS then print MESS before, and unless TYPEAHEADOKFLG is
on, clear buffers before and restore afterwards) (PROG ((CNT (ITIMES DWIMWAIT
2)) R BUFS RSLT) (COND (MESS (COND ((AND (READP T) (NOT TYPEAHEADOKFLG)) (PRIN1
BELLS T) (DOBE) (SETQ BUFS (CLBUFS)))) (COND ((STRINGP MESS) (PRIN1 MESS T))
(T (MAPRINT MESS T NIL "? "))))) (AND (NLISTP DEFAULT) (SETQ DEFAULT (SELECTQ
DEFAULT (Y (QUOTE ((Y . es) (N . o)))) (N (QUOTE ((N . o) (Y . es)))) DEFAULT)))
LP (COND ((MINUSP (SETQ CNT (SUB1 CNT))) (PRIN1 "...") (COND ((NLISTP DEFAULT)
(PRINT1 DEFAULT T) (RETURN DEFAULT)) (T (PRIN1 (SETQ R (CAAR DEFAULT))) (GO
GOTIT)))) ((NOT (READP T)) (DISMISS 500) (GO LP))) RETRY (COND ((LISTP DEFAULT)
(SETQ R (RESETFORM (CONTROL T) (READC T)))) (T (SETQ RSLT (READ T)) (GO RETURN)))
GOTIT (COND ((SETQ RSLT (ASSOC R DEFAULT)) (PRINT1 (CDR RSLT) T) (SETQ RSLT
(CAR RSLT))) ((OR (EQ R (QUOTE % )) (EQ R (QUOTE %
))) (GO RETRY)) (T (MAPRINT DEFAULT T (COND ((NEQ R (QUOTE ?)) (QUOTE 
"
Please type one of: ")) (T (QUOTE "
"))) "--" ", " (FUNCTION (LAMBDA (X) (PRIN1 (CAR X) T) (COND ((EQ R (QUOTE
?)) (PRIN1 (CDR X) T)))))) (GO RETRY))) RETURN (AND BUFS (BKBUFS BUFS)) (RETURN
RSLT))))

(PUTPROP
(LAMBDA (NAM PROP VAL) (* This isn't really optimal, as the best implementation
would say WHICH PROP needed dumping) (/RPLACA (QUOTE CHANGEDPROPLST) (CONS
NAM CHANGEDPROPLST)) (/PUT NAM PROP VAL)))

(PRIN1L
(LAMBDA N (for I from 1 to N do (PRIN1 (ARG N I) T))))

(PRINT1
(LAMBDA (X FILE) (PRIN1 X FILE) (TERPRI FILE) X))

(EDITM
(NLAMBDA X (PROG ((Y USERMACROS)) LP (EDITL (LIST (OR (ASSOC (CAR X) Y) (ASSOC
(CAR X) (SETQ Y EDITMACROS)) (ERROR X "NOT FOUND" T)) Y) (CDR X) (CAR X)))
(CAAR (/RPLACA (QUOTE CHANGEDITMACROS) (CONS (CAR X) CHANGEDITMACROS)))))

(?=
(LAMBDA (FORM) (COND ((EQ (CAR FORM) (QUOTE STRUCFORM)) (SETQ FORM (CDR FORM))))
(OR (GETD (CAR FORM)) (ERROR (CAR FORM) "not a function" T)) (RESETFORM (
PRINTLEVEL 3) (SELECTQ (ARGTYPE (CAR FORM)) ((0 1 NIL) (MAPC (COND ((GETD
(CAR FORM)) (ARGLIST (CAR FORM))) ((GETP (CAR FORM) (QUOTE EXPR)) (CADR (GETP
(CAR FORM) (QUOTE EXPR)))) (T (ERROR (CAR FORM) "not a function" T))) (FUNCTION
(LAMBDA (X) (PRIN1 X T) (PRIN1 " = " T) (PRINT (CAR (SETQ FORM (CDR FORM)))
T))))) (PROGN (PRIN1 (ARGLIST (CAR FORM)) T) (PRIN1 " = " T) (PRINT (CDR FORM)
T))))))

(DE
(NLAMBDA L (DEFINE (LIST L))))

(FIRSTATOM
(LAMBDA (X) (COND ((NLISTP X) X) (T (OR (FIRSTATOM (CAR X)) (FIRSTATOM (CDR
X)))))))

(COPYFILE
(LAMBDA (FROMFILE STOP START TOFILE) (* Copies bytes from file FROMFILE to
TOFILE (or current output file) from START to STOP; if START is not given,
current FILPOS is used (or 0 if file was not open) and STOP is assumed to
be an increment ; if STOP is not given, EOF is used - Leaves file open) (AND
START (SFPTR FROMFILE START)) (ASSEMBLE NIL (PUSH NP , = 0) (CQ (VAG (COND
((NULL STOP) -1) (START (IPLUS 2 (IDIFFERENCE STOP START))) (T (ADD1 STOP)))))
(PUSHN) (* -3 COUNT) (CQ (VAG (OPNJFN (INPUT (INFILE FROMFILE))))) (PUSHN)
(* IN JFN) (CQ (VAG (OPNJFN (OUTPUT (OUTFILE TOFILE))))) (PUSHN) (* IN JFN
AT 0 (NP)) LP (SOSN 0 , -2 (NP)) (JUMPA DONE) (* DECREMENT COUNT AND JUMP
IF OUT) (MOVE 1 , -1 (NP)) (JSYS 40) (* BIN) (MOVEM 2 , -3 (NP)) (JSYS 20)
(* GTSTS - GET STATUS) (TLNE 2 , 512) (JUMPA DONE) (* EOF?) (MOVE 2 , -3 (NP))
(MOVE 1 , 0 (NP)) (JSYS 41) (* BOUT) (JRST LP) DONE (SUB NP , = 1048580) (CQ
NIL))))

(PUTONFILE
(LAMBDA (ITEM TYPE FILE) (PROG (TYPELST FILEVARS) (OR (GETP FILE (QUOTE FILE))
(/PUT FILE (QUOTE FILE)) (LIST NIL (FILEVARS FILE))) (OR (SETQ TYPELST (ASSOC
TYPE (CAR (SETQ FILEVARS (FILEVARS FILE))))) (/RPLACA FILEVARS (NCONC1 (CAR
FILEVARS) (SETQ TYPELST (LIST TYPE))))) (OR (MEMB FILE FILELST) (/RPLACA (QUOTE
FILELST) (CONS FILE FILELST))) (SELECTQ TYPE (PROP (OR (CDR TYPELST) (/RPLACD
TYPELST (LIST (QUOTE ALL)))) (COND ((NEQ (CADR TYPELST) (QUOTE ALL)) (/RPLACA
(CDR TYPELST) (UNION (for X in (CDR ITEM) by (CDDR X) when (RP (LIST "property"
X "?")) collect X) (OR (LISTP (CADR TYPELST)) (LIST (CADR TYPELST))))))) (SETQ
TYPELST (CDR TYPELST))) NIL) (OR (MEMB ITEM (CDR TYPELST)) (/NCONC1 TYPELST
ITEM)))))

(DOFILES
(LAMBDA (OPTIONS FLG) (PROG (OLDNAME LST) (UPDATEFILES) (for X in PRETTYTYPELST
when (AND (CADR X) (CADDR X) (LISTP (CAAR X))) do (COND (FLG (PRIN1 " The "
T)) (T (SETQ FLG (PRIN1 "In what file shall I put the following " T)))) (PRIN1
(CADDR X) T) (PRIN1 "...
" T) (for XL on (CAAR X) do (PROG ((FILENAME (RP (CAR XL) (QUOTE (<filename>,
T, NIL, or FORGET)))) TEM (ITEM (CAR XL))) (COND ((EQ FILENAME T) (COND ((NOT
(SETQ FILENAME OLDNAME)) (PRIN1 "Huh?
" T) (SETQ FILENAME (RP "FILE")))))) LP (COND ((NULL FILENAME) (RETURN)) ((EQ
FILENAME (QUOTE FORGET)) (/RPLACA XL) (RETURN)) ((MEMB FILENAME FILELST) (SETQ
OLDNAME FILENAME) (PUTONFILE ITEM (CADR X) FILENAME)) ((SETQ TEM (FIXSPELL
FILENAME 70 (CONS (QUOTE FORGET) FILELST) NIL NIL (FUNCTION (LAMBDA (X) (NOT
(STRPOS ".COM" X)))) T (QUOTE MUSTAPPROVE))) (SETQ FILENAME TEM) (GO LP))
(T (/RPLACA (QUOTE FILELST) (CONS FILENAME FILELST)) (/PUT FILENAME (QUOTE
FILE) (LIST (/RPLACA (FILEFNS FILENAME)) (/RPLACA (FILEVARS FILENAME)))) (GO
LP)))))) (UPDATEFILES) (SETQ FLG) (for FILE in FILELST when (CDDR (GETP FILE
(QUOTE FILE))) do (PROG NIL (OR FLG (SETQ FLG (PRIN1 "Shall I dump the file "
T))) LP (SELECTQ (APPLY* (QUOTE Y/N) (QUOTE ((N . o) (F . ast) (C . lispify)
(D . wimify) (Y . es) (I . gnore% changes) (W . hat% changed?) (E . 
punge% this% file))) (LIST FILE) T) (I (/RPLACD (CDR (GETP FILE (QUOTE FILE)))))
(E (/RPLACA (MEMB FILE FILELST))) (Y (SETQ LST (CONS (CONS FILE OPTIONS) LST)))
(F (SETQ LST (CONS (CONS FILE (QUOTE FAST)) LST))) (D (SETQ LST (CONS (CONS
FILE (QUOTE CLISP% )) LST))) (C (SETQ LST (CONS (CONS FILE (QUOTE CLISPIFY))
LST))) (N) (W (MAPRINT (CDDR (GETP FILE (QUOTE FILE))) T NIL 
"
have been changed....
Dump " (QUOTE ,)) (GO LP)) (HELP)))) (/DREMOVE NIL FILELST) (COND (LST (for
X in LST do (PRIN1 "Dumping " T) (PRINT (CAR X) T) (PRINT (MAKEFILE (CAR X)
(CDR X)) T)))) (AND NOTCOMPILEDFILES (SETQ LST (for X in NOTCOMPILEDFILES
when (EQ (APPLY* (QUOTE Y/N) (QUOTE N) (LIST "compile " X)) (QUOTE Y)) collect
X)) (APPLY (QUOTE COMPILEFILES) LST)) (AND NOTLISTEDFILES (SETQ LST (for X
in NOTLISTEDFILES when (AND X (EQ (APPLY* (QUOTE Y/N) (QUOTE N) (LIST "list "
X)) (QUOTE Y))) COLLECT X)) (APPLY (QUOTE LISTFILES) LST)))))

(RP
(LAMBDA (STR OPTION) (PROG NIL (COND ((NULL STR)) ((LISTP STR) (MAPRINT STR
T)) (T (PRIN1 STR T))) LP (PRIN1 "?" T) (COND ((AND (EQ (SETQ STR (READ T))
(QUOTE ?)) OPTION) (PRIN1 OPTION T) (TERPRI T) (GO LP))) (RETURN STR))))

(LISTFILE1
  [LAMBDA (LOCALFILES FOREIGNFILES LISTFILEHOST LISTFILELOGIN)
    (PROG ((CR "
"))
          (SETQ LOCALFILES (OR (REVERSE LOCALFILES)
			       (LIST LOCALFILES)))
          [SETQ FOREIGNFILES (OR (REVERSE FOREIGNFILES)
				 (AND FOREIGNFILES (LIST FOREIGNFILES]
          (CONCAT
	    "FTP " LISTFILEHOST CR "LOG "
	    [OR LISTFILELOGIN (GETP LISTFILEHOST (QUOTE LOGIN))
		(PROGN (PRIN1 LISTFILEHOST T)
		       (/PUT LISTFILEHOST (QUOTE LOGIN)
			     (OR (Y/N NIL "login {enter string⎇:  ")
				 (RETFROM (QUOTE LISTFILES]
	    CR "TE" CR
	    (for X in LOCALFILES bind ((RSLT←""))
	       do
		(SETQ RSLT
		  (CONCAT
		    "SE " X "≠" CR
		    (OR
		      (PROG1 (CAR FOREIGNFILES)
			     (SETQ FOREIGNFILES (CDR FOREIGNFILES)))
		      (PROGN
			[SETQ TEM
			  (SUBSTRING
			    X
			    ([LAMBDA (TEM)
				(OR (AND (FMEMB HOST (QUOTE (SU-AI SAIL)))
					 (STRPOS "S-" X TEM NIL T T))
				    TEM]
			      (OR (STRPOS ">" X NIL NIL NIL T)
				  1))
			    (IMIN [SUB1 (OR (STRPOS ";" X)
					    (ADD1 (NCHARS X]
				  (IPLUS 3 (OR (STRPOS "." X)
					       99]
			(COND
			  ((EQ (NTHCHAR TEM -1)
			       (QUOTE %.))
			    (GLC TEM)))
			TEM))
		    CR CR RSLT))
	       finally (RETURN RSLT))
	    "QUI" CR])

(IMIN
(LAMBDA (X Y) (COND ((IGREATERP X Y) Y) (T X))))

(IMAX
  [LAMBDA (X Y)
    (COND
      ((IGREATERP X Y)
	X)
      (T Y])

(DWIMUSERFN
(LAMBDA (MACVAL) (* This function is called (if the value of DWIMUSERFN is
T) by DWIM if DWIM doesn't think that a "FORM" is CLISP. The definition given
here says that, if (FOO --) is in the code, and FOO doesn't have a function
definition, but does have a macro property, to use the expansion of the macro.
The call to "CLISPTRAN" puts the translation in the CLISP hash array, where
other translations of CLISP are kept) (AND (NOT FAULTAPPLYFLG) (LISTP FAULTX)
(LITATOM (CAR FAULTX)) (NOT (FGETD (CAR FAULTX))) (SETQ MACVAL (GETP (CAR
FAULTX) (QUOTE MACRO))) (NOT (EDITFINDP MACVAL (QUOTE ASSEMBLE))) (CLISPTRAN
FAULTX (COND ((FMEMB (CAR MACVAL) (QUOTE (LAMBDA NLAMBDA))) (CONS MACVAL (CDR
FAULTX))) ((AND (CAR MACVAL) (ATOM (CAR MACVAL))) (EVALA (CADR MACVAL) (LIST
(CONS (CAR MACVAL) (CDR FAULTX))))) (T (SUBPAIR (CAR MACVAL) (PROGN (DWIMIFY1B
(CDR FAULTX) FAULTX T T NIL FAULTFN) (CDR FAULTX)) (CADR MACVAL))))) FAULTX)))
)
  (ADDTOVAR USERMACROS [FV NIL (E (FREEVARS (## (ORR (UP 1)
						     NIL]
	    (LOCAL NIL (LCL TTY:))
	    (Q NIL (MBD QUOTE))
	    [EV NIL (ORR [(E (LISPXEVAL (LIST (QUOTE EDITV)
					      (FIRSTATOM (##)))
					(QUOTE EV->]
			 ((E (QUOTE EV?]
	    [EP NIL (ORR [(E (LISPXEVAL (LIST (QUOTE EDITP)
					      (FIRSTATOM (##)))
					(QUOTE EP->]
			 ((E (QUOTE EP?]
	    [?= NIL (ORR ((E (?= (##))
			     T))
			 ((E (QUOTE ?=?]
	    (- NIL (ORR NX !NX))
	    [EVAL NIL (E (LISPXEVAL (## (ORR (UP 1)
					     NIL))
				    (QUOTE *]
	    [?= NIL (ORR [(E (MAP2C (ARGLIST (## 1))
				    (## 2 UP)
				    (FUNCTION (LAMBDA (X Y)
						      (PRIN1 X T)
						      (PRIN1 " = " T)
						      (PRINT Y T]
			 ((E (QUOTE ?=?]
	    [EF NIL (ORR [(E (LISPXEVAL (LIST (QUOTE EDITF)
					      (FIRSTATOM (##)))
					(QUOTE EF->]
			 ((E (QUOTE EF?]
	    (MAC (X . Y)
		 (E (/RPLACA (QUOTE CHANGEDITMACROS)
			     (CONS (COND ((LISTP (QUOTE X))
					  (CAR (QUOTE X)))
					 (T (QUOTE X)))
				   CHANGEDITMACROS))
		    T)
		 (M X . Y))
	    (!← NIL !0))
  (ADDTOVAR EDITCOMSA !← EF ?= EVAL - ?= EP EV Q LOCAL FV)
  (ADDTOVAR EDITCOMSL MAC)
(DEFLIST(QUOTE(
  [CONCAT-IN-LISTFILES ((LISTFILES . CONCAT)
			(BEFORE NIL ([LAMBDA (HOST)
					     (COND ((NULL HOST)
						    (RETFROM (QUOTE LISTFILES)))
						   ((EQ HOST T))
						   (T (RETURN (LISTFILE1 FILES 
									NIL 
								       HOST]
				 (OR LPTSITE (SETQ LPTSITE
						   (Y/N T "Listing site? "]
))(QUOTE READVICE))

  (READVISE CONCAT-IN-LISTFILES)
  (SETQ ADVISEDFNS)
  (SETQ LISPXMACROS (CONS (LIST (QUOTE ;)
				(KWOTE (PACK)))
			  LISPXMACROS))
  (ADDTOVAR PRETTYTYPELST (CHANGEDITMACROS USERMACROS "edit macros")
	    (NEWVARSLST VARS "variables")
	    (CHANGEDPROPLST PROP "properties")
	    (CHANGEDADVICELST ADVICE "advice"))
  (ADDTOVAR HISTORYCOMS ;)
  (ADDTOVAR LISPXCOMS ;)
  (RPAQ LPTSITE)
  (RPAQ NEWVARSLST)
  (RPAQ CHANGEDITMACROS)
  (RPAQ CHANGEDPROPLST)
  (RPAQ CHANGEDADVICELST)
  (RPAQQ DWIMUSERFN T)
  (I.S.TYPE (QUOTE ANY)
	    (QUOTE (AND (SETQ $$VAL BODY)
			(RETURN $$VAL)))
	    NIL
	    (QUOTE $$VAL))
  (I.S.TYPE (QUOTE RCOLLECT)
	    (QUOTE (SETQ $$VAL (CONS BODY $$VAL)))
	    NIL
	    (QUOTE $$VAL))
  (I.S.TYPE (QUOTE MAXIMUM)
	    (QUOTE (SETQ $$VAL (MAX $$VAL BODY)))
	    -27022703623
	    (QUOTE $$VAL))
  (I.S.TYPE (QUOTE MINIMUM)
	    (QUOTE (SETQ $$VAL (MIN $$VAL BODY)))
	    27022703623
	    (QUOTE $$VAL))
STOP